home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / clrpick.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  20.8 KB  |  695 lines
  1. # clrpick.tcl --
  2. #
  3. #    Color selection dialog for platforms that do not support a
  4. #    standard color selection dialog.
  5. #
  6. # RCS: @(#) $Id: clrpick.tcl,v 1.22 2006/03/17 11:13:15 patthoyts Exp $
  7. #
  8. # Copyright (c) 1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # ToDo:
  14. #
  15. #    (1): Find out how many free colors are left in the colormap and
  16. #         don't allocate too many colors.
  17. #    (2): Implement HSV color selection. 
  18. #
  19.  
  20. # Make sure namespaces exist
  21. namespace eval ::tk {}
  22. namespace eval ::tk::dialog {}
  23. namespace eval ::tk::dialog::color {
  24.     namespace import ::tk::msgcat::*
  25. }
  26.  
  27. # ::tk::dialog::color:: --
  28. #
  29. #    Create a color dialog and let the user choose a color. This function
  30. #    should not be called directly. It is called by the tk_chooseColor
  31. #    function when a native color selector widget does not exist
  32. #
  33. proc ::tk::dialog::color:: {args} {
  34.     variable ::tk::Priv
  35.     set dataName __tk__color
  36.     upvar ::tk::dialog::color::$dataName data
  37.     set w .$dataName
  38.  
  39.     # The lines variables track the start and end indices of the line
  40.     # elements in the colorbar canvases.
  41.     set data(lines,red,start)   0
  42.     set data(lines,red,last)   -1
  43.     set data(lines,green,start) 0
  44.     set data(lines,green,last) -1
  45.     set data(lines,blue,start)  0
  46.     set data(lines,blue,last)  -1
  47.  
  48.     # This is the actual number of lines that are drawn in each color strip.
  49.     # Note that the bars may be of any width.
  50.     # However, NUM_COLORBARS must be a number that evenly divides 256.
  51.     # Such as 256, 128, 64, etc.
  52.     set data(NUM_COLORBARS) 16
  53.  
  54.     # BARS_WIDTH is the number of pixels wide the color bar portion of the
  55.     # canvas is. This number must be a multiple of NUM_COLORBARS
  56.     set data(BARS_WIDTH) 160
  57.  
  58.     # PLGN_WIDTH is the number of pixels wide of the triangular selection
  59.     # polygon. This also results in the definition of the padding on the 
  60.     # left and right sides which is half of PLGN_WIDTH. Make this number even.
  61.     set data(PLGN_HEIGHT) 10
  62.  
  63.     # PLGN_HEIGHT is the height of the selection polygon and the height of the 
  64.     # selection rectangle at the bottom of the color bar. No restrictions.
  65.     set data(PLGN_WIDTH) 10
  66.  
  67.     Config $dataName $args
  68.     InitValues $dataName
  69.  
  70.     set sc [winfo screen $data(-parent)]
  71.     set winExists [winfo exists $w]
  72.     if {!$winExists || $sc ne [winfo screen $w]} {
  73.     if {$winExists} {
  74.         destroy $w
  75.     }
  76.     toplevel $w -class TkColorDialog -screen $sc
  77.     BuildDialog $w
  78.     }
  79.  
  80.     # Dialog boxes should be transient with respect to their parent,
  81.     # so that they will always stay on top of their parent window.  However,
  82.     # some window managers will create the window as withdrawn if the parent
  83.     # window is withdrawn or iconified.  Combined with the grab we put on the
  84.     # window, this can hang the entire application.  Therefore we only make
  85.     # the dialog transient if the parent is viewable.
  86.  
  87.     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  88.     wm transient $w $data(-parent)
  89.     }
  90.  
  91.     # 5. Withdraw the window, then update all the geometry information
  92.     # so we know how big it wants to be, then center the window in the
  93.     # display and de-iconify it.
  94.  
  95.     ::tk::PlaceWindow $w widget $data(-parent)
  96.     wm title $w $data(-title)
  97.  
  98.     # 6. Set a grab and claim the focus too.
  99.  
  100.     ::tk::SetFocusGrab $w $data(okBtn)
  101.  
  102.     # 7. Wait for the user to respond, then restore the focus and
  103.     # return the index of the selected button.  Restore the focus
  104.     # before deleting the window, since otherwise the window manager
  105.     # may take the focus away so we can't redirect it.  Finally,
  106.     # restore any grab that was in effect.
  107.  
  108.     vwait ::tk::Priv(selectColor)
  109.     set result $Priv(selectColor)
  110.     ::tk::RestoreFocusGrab $w $data(okBtn)
  111.     unset data
  112.  
  113.     return $result
  114. }
  115.  
  116. # ::tk::dialog::color::InitValues --
  117. #
  118. #    Get called during initialization or when user resets NUM_COLORBARS
  119. #
  120. proc ::tk::dialog::color::InitValues {dataName} {
  121.     upvar ::tk::dialog::color::$dataName data
  122.  
  123.     # IntensityIncr is the difference in color intensity between a colorbar
  124.     # and its neighbors.
  125.     set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
  126.  
  127.     # ColorbarWidth is the width of each colorbar
  128.     set data(colorbarWidth) [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
  129.  
  130.     # Indent is the width of the space at the left and right side of the
  131.     # colorbar. It is always half the selector polygon width, because the
  132.     # polygon extends into the space.
  133.     set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
  134.  
  135.     set data(colorPad) 2
  136.     set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]
  137.  
  138.     #
  139.     # minX is the x coordinate of the first colorbar
  140.     #
  141.     set data(minX) $data(indent)
  142.  
  143.     #
  144.     # maxX is the x coordinate of the last colorbar
  145.     #
  146.     set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
  147.  
  148.     #
  149.     # canvasWidth is the width of the entire canvas, including the indents
  150.     #
  151.     set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
  152.  
  153.     # Set the initial color, specified by -initialcolor, or the
  154.     # color chosen by the user the last time.
  155.     set data(selection) $data(-initialcolor)
  156.     set data(finalColor)  $data(-initialcolor)
  157.     set rgb [winfo rgb . $data(selection)]
  158.  
  159.     set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]
  160.     set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
  161.     set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]
  162. }
  163.  
  164. # ::tk::dialog::color::Config  --
  165. #
  166. #    Parses the command line arguments to tk_chooseColor
  167. #
  168. proc ::tk::dialog::color::Config {dataName argList} {
  169.     variable ::tk::Priv
  170.     upvar ::tk::dialog::color::$dataName data
  171.  
  172.     # 1: the configuration specs
  173.     #
  174.     if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} {
  175.     set defaultColor $Priv(selectColor)
  176.     } else {
  177.     set defaultColor [. cget -background]
  178.     }
  179.  
  180.     set specs [list \
  181.         [list -initialcolor "" "" $defaultColor] \
  182.         [list -parent "" "" "."] \
  183.         [list -title "" "" [mc "Color"]] \
  184.         ]
  185.  
  186.     # 2: parse the arguments
  187.     #
  188.     tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
  189.  
  190.     if {$data(-title) eq ""} {
  191.     set data(-title) " "
  192.     }
  193.     if {[catch {winfo rgb . $data(-initialcolor)} err]} {
  194.     error $err
  195.     }
  196.  
  197.     if {![winfo exists $data(-parent)]} {
  198.     error "bad window path name \"$data(-parent)\""
  199.     }
  200. }
  201.  
  202. # ::tk::dialog::color::BuildDialog --
  203. #
  204. #    Build the dialog.
  205. #
  206. proc ::tk::dialog::color::BuildDialog {w} {
  207.     upvar ::tk::dialog::color::[winfo name $w] data
  208.  
  209.     # TopFrame contains the color strips and the color selection
  210.     #
  211.     set topFrame [frame $w.top -relief raised -bd 1]
  212.  
  213.     # StripsFrame contains the colorstrips and the individual RGB entries
  214.     set stripsFrame [frame $topFrame.colorStrip]
  215.  
  216.     set maxWidth [::tk::mcmaxamp &Red &Green &Blue]
  217.     set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}]
  218.     set colorList {
  219.     red   "&Red"
  220.     green "&Green"
  221.     blue  "&Blue"
  222.     }
  223.     foreach {color l} $colorList {
  224.     # each f frame contains an [R|G|B] entry and the equiv. color strip.
  225.     set f [frame $stripsFrame.$color]
  226.  
  227.     # The box frame contains the label and entry widget for an [R|G|B]
  228.     set box [frame $f.box]
  229.  
  230.     ::tk::AmpWidget label $box.label -text "[mc $l]:" \
  231.         -width $maxWidth -anchor ne
  232.     bind $box.label <<AltUnderlined>> [list focus $box.entry]
  233.  
  234.     entry $box.entry -textvariable \
  235.         ::tk::dialog::color::[winfo name $w]($color,intensity) \
  236.         -width 4
  237.     pack $box.label -side left -fill y -padx 2 -pady 3
  238.     pack $box.entry -side left -anchor n -pady 0
  239.     pack $box -side left -fill both
  240.  
  241.     set height [expr {
  242.         [winfo reqheight $box.entry] -
  243.         2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])
  244.     }]
  245.  
  246.     canvas $f.color -height $height \
  247.         -width $data(BARS_WIDTH) -relief sunken -bd 2
  248.     canvas $f.sel -height $data(PLGN_HEIGHT) \
  249.         -width $data(canvasWidth) -highlightthickness 0
  250.     pack $f.color -expand yes -fill both
  251.     pack $f.sel -expand yes -fill both
  252.  
  253.     pack $f -side top -fill x -padx 0 -pady 2
  254.  
  255.     set data($color,entry) $box.entry
  256.     set data($color,col) $f.color
  257.     set data($color,sel) $f.sel
  258.  
  259.     bind $data($color,col) <Configure> \
  260.         [list tk::dialog::color::DrawColorScale $w $color 1]
  261.     bind $data($color,col) <Enter> \
  262.         [list tk::dialog::color::EnterColorBar $w $color]
  263.     bind $data($color,col) <Leave> \
  264.         [list tk::dialog::color::LeaveColorBar $w $color]
  265.  
  266.     bind $data($color,sel) <Enter> \
  267.         [list tk::dialog::color::EnterColorBar $w $color]
  268.     bind $data($color,sel) <Leave> \
  269.         [list tk::dialog::color::LeaveColorBar $w $color]
  270.  
  271.     bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
  272.     }
  273.  
  274.     pack $stripsFrame -side left -fill both -padx 4 -pady 10
  275.  
  276.     # The selFrame contains a frame that demonstrates the currently
  277.     # selected color
  278.     #
  279.     set selFrame [frame $topFrame.sel]
  280.     set lab [::tk::AmpWidget label $selFrame.lab \
  281.         -text [mc "&Selection:"] -anchor sw]
  282.     set ent [entry $selFrame.ent \
  283.         -textvariable ::tk::dialog::color::[winfo name $w](selection) \
  284.         -width 16]
  285.     set f1  [frame $selFrame.f1 -relief sunken -bd 2]
  286.     set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
  287.  
  288.     pack $lab $ent -side top -fill x -padx 4 -pady 2
  289.     pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
  290.     pack $data(finalCanvas) -expand yes -fill both
  291.  
  292.     bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w]
  293.  
  294.     pack $selFrame -side left -fill none -anchor nw
  295.     pack $topFrame -side top -expand yes -fill both -anchor nw
  296.  
  297.     # the botFrame frame contains the buttons
  298.     #
  299.     set botFrame [frame $w.bot -relief raised -bd 1]
  300.  
  301.     ::tk::AmpWidget button $botFrame.ok     -text [mc "&OK"]        \
  302.         -command [list tk::dialog::color::OkCmd $w]
  303.     ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"]    \
  304.         -command [list tk::dialog::color::CancelCmd $w]
  305.  
  306.     set data(okBtn)      $botFrame.ok
  307.     set data(cancelBtn)  $botFrame.cancel
  308.  
  309.     grid x $botFrame.ok x $botFrame.cancel x -sticky ew
  310.     grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
  311.     grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
  312.     grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
  313.     grid columnconfigure $botFrame 2 -weight 2 -uniform space
  314.     pack $botFrame -side bottom -fill x
  315.  
  316.     # Accelerator bindings
  317.     bind $lab <<AltUnderlined>> [list focus $ent]
  318.     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
  319.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  320.  
  321.     wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
  322.     bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w]
  323. }
  324.  
  325. # ::tk::dialog::color::SetRGBValue --
  326. #
  327. #    Sets the current selection of the dialog box
  328. #
  329. proc ::tk::dialog::color::SetRGBValue {w color} {
  330.     upvar ::tk::dialog::color::[winfo name $w] data 
  331.  
  332.     set data(red,intensity)   [lindex $color 0]
  333.     set data(green,intensity) [lindex $color 1]
  334.     set data(blue,intensity)  [lindex $color 2]
  335.  
  336.     RedrawColorBars $w all
  337.  
  338.     # Now compute the new x value of each colorbars pointer polygon
  339.     foreach color {red green blue} {
  340.     set x [RgbToX $w $data($color,intensity)]
  341.     MoveSelector $w $data($color,sel) $color $x 0
  342.     }
  343. }
  344.  
  345. # ::tk::dialog::color::XToRgb --
  346. #
  347. #    Converts a screen coordinate to intensity
  348. #
  349. proc ::tk::dialog::color::XToRgb {w x} {
  350.     upvar ::tk::dialog::color::[winfo name $w] data
  351.  
  352.     set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
  353.     if {$x > 255} {
  354.     set x 255
  355.     }
  356.     return $x
  357. }
  358.  
  359. # ::tk::dialog::color::RgbToX
  360. #
  361. #    Converts an intensity to screen coordinate.
  362. #
  363. proc ::tk::dialog::color::RgbToX {w color} {
  364.     upvar ::tk::dialog::color::[winfo name $w] data
  365.  
  366.     return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
  367. }
  368.  
  369. # ::tk::dialog::color::DrawColorScale --
  370. # 
  371. #    Draw color scale is called whenever the size of one of the color
  372. #    scale canvases is changed.
  373. #
  374. proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
  375.     upvar ::tk::dialog::color::[winfo name $w] data
  376.  
  377.     # col: color bar canvas
  378.     # sel: selector canvas
  379.     set col $data($c,col)
  380.     set sel $data($c,sel)
  381.  
  382.     # First handle the case that we are creating everything for the first time.
  383.     if {$create} {
  384.     # First remove all the lines that already exist.
  385.     if { $data(lines,$c,last) > $data(lines,$c,start)} {
  386.         for {set i $data(lines,$c,start)} \
  387.             {$i <= $data(lines,$c,last)} {incr i} {
  388.         $sel delete $i
  389.         }
  390.     }
  391.     # Delete the selector if it exists
  392.     if {[info exists data($c,index)]} {
  393.         $sel delete $data($c,index)
  394.     }
  395.  
  396.     # Draw the selection polygons
  397.     CreateSelector $w $sel $c
  398.     $sel bind $data($c,index) <ButtonPress-1> \
  399.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
  400.     $sel bind $data($c,index) <B1-Motion> \
  401.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  402.     $sel bind $data($c,index) <ButtonRelease-1> \
  403.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  404.  
  405.     set height [winfo height $col]
  406.     # Create an invisible region under the colorstrip to catch mouse clicks
  407.     # that aren't on the selector.
  408.     set data($c,clickRegion) [$sel create rectangle 0 0 \
  409.         $data(canvasWidth) $height -fill {} -outline {}]
  410.  
  411.     bind $col <ButtonPress-1> \
  412.         [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
  413.     bind $col <B1-Motion> \
  414.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
  415.     bind $col <ButtonRelease-1> \
  416.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
  417.  
  418.     $sel bind $data($c,clickRegion) <ButtonPress-1> \
  419.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
  420.     $sel bind $data($c,clickRegion) <B1-Motion> \
  421.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  422.     $sel bind $data($c,clickRegion) <ButtonRelease-1> \
  423.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  424.     } else {
  425.     # l is the canvas index of the first colorbar.
  426.     set l $data(lines,$c,start)
  427.     }
  428.  
  429.     # Draw the color bars.
  430.     set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
  431.     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
  432.     set intensity [expr {$i * $data(intensityIncr)}]
  433.     set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
  434.     if {$c eq "red"} {
  435.         set color [format "#%02x%02x%02x" \
  436.             $intensity $data(green,intensity) $data(blue,intensity)]
  437.     } elseif {$c eq "green"} {
  438.         set color [format "#%02x%02x%02x" \
  439.             $data(red,intensity) $intensity $data(blue,intensity)]
  440.     } else {
  441.         set color [format "#%02x%02x%02x" \
  442.             $data(red,intensity) $data(green,intensity) $intensity]
  443.     }
  444.  
  445.     if {$create} {
  446.         set index [$col create rect $startx $highlightW \
  447.             [expr {$startx +$data(colorbarWidth)}] \
  448.             [expr {[winfo height $col] + $highlightW}] \
  449.             -fill $color -outline $color]
  450.     } else {
  451.         $col itemconfigure $l -fill $color -outline $color
  452.         incr l
  453.     }
  454.     }
  455.     $sel raise $data($c,index)
  456.  
  457.     if {$create} {
  458.     set data(lines,$c,last) $index
  459.     set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
  460.     }
  461.  
  462.     RedrawFinalColor $w
  463. }
  464.  
  465. # ::tk::dialog::color::CreateSelector --
  466. #
  467. #    Creates and draws the selector polygon at the position
  468. #    $data($c,intensity).
  469. #
  470. proc ::tk::dialog::color::CreateSelector {w sel c } {
  471.     upvar ::tk::dialog::color::[winfo name $w] data
  472.     set data($c,index) [$sel create polygon \
  473.         0 $data(PLGN_HEIGHT) \
  474.         $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
  475.         $data(indent) 0]
  476.     set data($c,x) [RgbToX $w $data($c,intensity)]
  477.     $sel move $data($c,index) $data($c,x) 0
  478. }
  479.  
  480. # ::tk::dialog::color::RedrawFinalColor
  481. #
  482. #    Combines the intensities of the three colors into the final color
  483. #
  484. proc ::tk::dialog::color::RedrawFinalColor {w} {
  485.     upvar ::tk::dialog::color::[winfo name $w] data
  486.  
  487.     set color [format "#%02x%02x%02x" $data(red,intensity) \
  488.         $data(green,intensity) $data(blue,intensity)]
  489.  
  490.     $data(finalCanvas) configure -bg $color
  491.     set data(finalColor) $color
  492.     set data(selection) $color
  493.     set data(finalRGB) [list \
  494.         $data(red,intensity) \
  495.         $data(green,intensity) \
  496.         $data(blue,intensity)]
  497. }
  498.  
  499. # ::tk::dialog::color::RedrawColorBars --
  500. #
  501. # Only redraws the colors on the color strips that were not manipulated.
  502. # Params: color of colorstrip that changed. If color is not [red|green|blue]
  503. #         Then all colorstrips will be updated
  504. #
  505. proc ::tk::dialog::color::RedrawColorBars {w colorChanged} {
  506.     upvar ::tk::dialog::color::[winfo name $w] data
  507.  
  508.     switch $colorChanged {
  509.     red { 
  510.         DrawColorScale $w green
  511.         DrawColorScale $w blue
  512.     }
  513.     green {
  514.         DrawColorScale $w red
  515.         DrawColorScale $w blue
  516.     }
  517.     blue {
  518.         DrawColorScale $w red
  519.         DrawColorScale $w green
  520.     }
  521.     default {
  522.         DrawColorScale $w red
  523.         DrawColorScale $w green
  524.         DrawColorScale $w blue
  525.     }
  526.     }
  527.     RedrawFinalColor $w
  528. }
  529.  
  530. #----------------------------------------------------------------------
  531. #            Event handlers
  532. #----------------------------------------------------------------------
  533.  
  534. # ::tk::dialog::color::StartMove --
  535. #
  536. #    Handles a mousedown button event over the selector polygon.
  537. #    Adds the bindings for moving the mouse while the button is
  538. #    pressed.  Sets the binding for the button-release event.
  539. # 
  540. # Params: sel is the selector canvas window, color is the color of the strip.
  541. #
  542. proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
  543.     upvar ::tk::dialog::color::[winfo name $w] data
  544.  
  545.     if {!$dontMove} {
  546.     MoveSelector $w $sel $color $x $delta
  547.     }
  548. }
  549.  
  550. # ::tk::dialog::color::MoveSelector --
  551. # 
  552. # Moves the polygon selector so that its middle point has the same
  553. # x value as the specified x. If x is outside the bounds [0,255],
  554. # the selector is set to the closest endpoint.
  555. #
  556. # Params: sel is the selector canvas, c is [red|green|blue]
  557. #         x is a x-coordinate.
  558. #
  559. proc ::tk::dialog::color::MoveSelector {w sel color x delta} {
  560.     upvar ::tk::dialog::color::[winfo name $w] data
  561.  
  562.     incr x -$delta
  563.  
  564.     if { $x < 0 } {
  565.     set x 0
  566.     } elseif { $x > $data(BARS_WIDTH)} {
  567.     set x $data(BARS_WIDTH)
  568.     }
  569.     set diff [expr {$x - $data($color,x)}]
  570.     $sel move $data($color,index) $diff 0
  571.     set data($color,x) [expr {$data($color,x) + $diff}]
  572.  
  573.     # Return the x value that it was actually set at
  574.     return $x
  575. }
  576.  
  577. # ::tk::dialog::color::ReleaseMouse
  578. #
  579. # Removes mouse tracking bindings, updates the colorbars.
  580. #
  581. # Params: sel is the selector canvas, color is the color of the strip,
  582. #         x is the x-coord of the mouse.
  583. #
  584. proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
  585.     upvar ::tk::dialog::color::[winfo name $w] data 
  586.  
  587.     set x [MoveSelector $w $sel $color $x $delta]
  588.  
  589.     # Determine exactly what color we are looking at.
  590.     set data($color,intensity) [XToRgb $w $x]
  591.  
  592.     RedrawColorBars $w $color
  593. }
  594.  
  595. # ::tk::dialog::color::ResizeColorbars --
  596. #
  597. #    Completely redraws the colorbars, including resizing the
  598. #    colorstrips
  599. #
  600. proc ::tk::dialog::color::ResizeColorBars {w} {
  601.     upvar ::tk::dialog::color::[winfo name $w] data
  602.  
  603.     if {
  604.     ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
  605.     (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)
  606.     } then {
  607.     set data(BARS_WIDTH) $data(NUM_COLORBARS)
  608.     }
  609.     InitValues [winfo name $w]
  610.     foreach color {red green blue} {
  611.     $data($color,col) configure -width $data(canvasWidth)
  612.     DrawColorScale $w $color 1
  613.     }
  614. }
  615.  
  616. # ::tk::dialog::color::HandleSelEntry --
  617. #
  618. #    Handles the return keypress event in the "Selection:" entry
  619. #
  620. proc ::tk::dialog::color::HandleSelEntry {w} {
  621.     upvar ::tk::dialog::color::[winfo name $w] data
  622.  
  623.     set text [string trim $data(selection)]
  624.     # Check to make sure that the color is valid
  625.     if {[catch {set color [winfo rgb . $text]} ]} {
  626.     set data(selection) $data(finalColor)
  627.     return
  628.     }
  629.  
  630.     set R [expr {[lindex $color 0]/0x100}]
  631.     set G [expr {[lindex $color 1]/0x100}]
  632.     set B [expr {[lindex $color 2]/0x100}]
  633.  
  634.     SetRGBValue $w "$R $G $B"
  635.     set data(selection) $text
  636. }
  637.  
  638. # ::tk::dialog::color::HandleRGBEntry --
  639. #
  640. #    Handles the return keypress event in the R, G or B entry
  641. #
  642. proc ::tk::dialog::color::HandleRGBEntry {w} {
  643.     upvar ::tk::dialog::color::[winfo name $w] data
  644.  
  645.     foreach c {red green blue} {
  646.     if {[catch {
  647.         set data($c,intensity) [expr {int($data($c,intensity))}]
  648.     }]} {
  649.         set data($c,intensity) 0
  650.     }
  651.  
  652.     if {$data($c,intensity) < 0} {
  653.         set data($c,intensity) 0
  654.     }
  655.     if {$data($c,intensity) > 255} {
  656.         set data($c,intensity) 255
  657.     }
  658.     }
  659.  
  660.     SetRGBValue $w "$data(red,intensity) \
  661.     $data(green,intensity) $data(blue,intensity)"
  662. }    
  663.  
  664. # mouse cursor enters a color bar
  665. #
  666. proc ::tk::dialog::color::EnterColorBar {w color} {
  667.     upvar ::tk::dialog::color::[winfo name $w] data
  668.  
  669.     $data($color,sel) itemconfigure $data($color,index) -fill red
  670. }
  671.  
  672. # mouse leaves enters a color bar
  673. #
  674. proc ::tk::dialog::color::LeaveColorBar {w color} {
  675.     upvar ::tk::dialog::color::[winfo name $w] data
  676.  
  677.     $data($color,sel) itemconfigure $data($color,index) -fill black
  678. }
  679.  
  680. # user hits OK button
  681. #
  682. proc ::tk::dialog::color::OkCmd {w} {
  683.     variable ::tk::Priv
  684.     upvar ::tk::dialog::color::[winfo name $w] data
  685.  
  686.     set Priv(selectColor) $data(finalColor)
  687. }
  688.  
  689. # user hits Cancel button or destroys window
  690. #
  691. proc ::tk::dialog::color::CancelCmd {w} {
  692.     variable ::tk::Priv
  693.     set Priv(selectColor) ""
  694. }
  695.